; The MIT License
; 
; Copyright (c) 2008 Christophe Grand
; 
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
; 
; The above copyright notice and this permission notice shall be included in
; all copies or substantial portions of the Software.
; 
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
; THE SOFTWARE

(clojure/in-ns 'js)
(clojure/refer 'clojure)
(clojure/refer 'template)

(defn esc-string [s]
	(. org.apache.commons.lang.StringEscapeUtils escapeJavaScript s))

(defn write-dyn-js [x]
	(cond
		(instance? Integer x) (write-unesc (str (int x)))
		(instance? Number x) (write-unesc (str (double x)))
		(string? x)	(write-unesc (str \' (esc-string x) \'))
		(symbol? x)	(write-unesc (name x))
		(nil? x) (write-unesc "null")))

(defmulti process-form seq-first nil)

(def process-vector)
(def process-map)

(def-process-fn process-js x
	(instance? Integer x) `(write-unesc ~(str (int x)))
	(instance? Number x) `(write-unesc ~(str (double x)))
	(symbol? x) `(write-unesc ~(name x))
	(keyword? x) `(write-unesc ~(name x))
	(string? x) `(write-unesc ~(str \' (esc-string x) \'))
	(seq? x) (process-form x)
	(vector? x) (process-vector x)
	(map? x) (process-map x)
	(nil? x) `(write-unesc "null"))

(def *statement-mode* true)

(defn expr [form]
	(binding [*statement-mode* nil] 
		(process-js form)))

(defn process-binding [[k v]]
	(wrap
		`(write-unesc ~(str "var " (name k) "=")) 
		(expr v)))

(defn statements 
	([forms]
		(statements nil forms))
	([bindings forms]
		(if *statement-mode*
			(interleave 
				(concat
					(map process-binding bindings) 
					(map process-js forms)) 
				(repeat `(write-unesc ";")))
			(let [return (last forms)
				forms (butlast forms)]
				(if (or bindings forms)
					`((write-unesc "(function(){")
						~@(binding [*statement-mode* true] (statements bindings forms))
						(write-unesc "return ")
						~(expr return)					
						(write-unesc "})()"))
					(list (expr return)))))))

(defmacro js* [& etc]
	(simplify `(with-escaping identity
		~@(statements etc))))

(defmacro js [& etc]
	(simplify `(nest (js* ~@etc))))

(defn process-vector [x]
	`(do
		(write-unesc "[")
		~@(interpose `(write-unesc ",") (map expr x))
		(write-unesc "]"))) 

(defn process-map [x]
	`(do
		(write-unesc "{")
		~@(interpose `(write-unesc ",") 
			(map (fn [[k v]] (wrap
								(expr k)
								`(write-unesc ":")
								(expr v))) x))
		(write-unesc "}"))) 

(defmethod process-form nil [[op & forms :as form]]
	(let [exform (macroexpand-1 form)]
		(cond 
			(not= exform form) (process-js exform)
			(keyword? op) `(do
								~(expr (first forms))
								(write-unesc "[")
								~(expr (name op))
								(write-unesc "]"))
			:else `(do
						~(expr op)
						(write-unesc "(")
						~@(interpose `(write-unesc ",") (map expr forms))
						(write-unesc ")")))))

(defmethod process-form `js [[op & forms]]
	(wrap (map process-js forms)))

(defmethod process-form `quote [[op form]]
	`(write-dyn-js ~form))

(defn process-op [op forms]
	(wrap (interpose `(write-unesc ~(name op)) (map expr forms))))

(doseq o `[+ - * / < > <= >=]
	(defmethod process-form o [[op & forms]]
		(process-op op forms)))

(comment defmethod process-form `+ [[op & forms]]
		(process-op op forms))
		
(defmethod process-form `do [[op & forms]]
	(wrap (statements forms)))

(defmethod process-form `. [[op this call & etc]]
	(let [[field args is-call] (cond 
							etc [call etc true] 
							(seq? call) [(first call) (rest call) true]
							:else [call etc nil])]
		`(do 
			~(expr this)
			~@(if (vector? call)
				`((write-unesc "[") ~(expr (first call)) (write-unesc "]"))
				`((write-unesc ".") (write-unesc ~(if (string? call) call (name call)))))
			~@(if is-call
				`((write-unesc "(") ~@(interpose `(write-unesc ",") (map expr args)) (write-unesc ")"))))))

(defmethod process-form `if [[op test then & [else]]]
	(if *statement-mode*
		`(do 
			(write-unesc "if(")
			~(expr test)
			(write-unesc "){")
			~(process-js then)
			~@(when else
				(list `(write-unesc "}else{") (process-js else)))
			(write-unesc "}"))
		`(do 
			(write-unesc "(")
			~(expr test)
			(write-unesc "?")
			~(expr then)
			(write-unesc ":")
			~(expr else)
			(write-unesc ")"))))

(defmethod process-form `let* [[op bindings & forms]]
	(wrap (statements (apply array-map bindings) forms)))

(defmethod process-form `fn* [[op & etc]]
	(let [etc (if (string? (first etc)) (rest etc) etc)
		bodies (if (vector? (first etc)) (list etc) etc)
		[args & forms] (first bodies)
		return (last forms)
		forms (butlast forms)]
		`(do
			(write-unesc "(function(")
			(write-unesc ~(apply str (interpose "," (map name args))))
			(write-unesc "){")
			~@(binding [*statement-mode* true] (statements forms))
			(write-unesc "return ")
			~(expr return)
			(write-unesc "})"))))

(defmethod process-form `nth [[op v i]]
	`(do
		~(expr v)
		(write-unesc "[")
		~(expr i)
		(write-unesc "]")))
